perm filename BEAMF.FAI[NEW,LCS] blob sn#149691 filedate 1975-03-10 generic text, type T, neo UTF8
00100		TITLE BEAMF
00200		ENTRY BEAMF
00300		EXTERNAL STF,MOD,.COMM.,AMOD
00400	
00500	
00700		RM←2↔ RX←3↔ RJ←4↔ RW←5↔ RH←6↔ RJA←7↔ RD←10↔ R9←11
00800		R8←12↔ RJX←13↔ RA←14↔ RJY←15
01500	BEAMF:	0     ;C  NEXT IS FOR BEAMS
01600		MOVE 	RM,STF+=8  ;90	RMINI=RSTJ2
01700		MOVE	RX,[=16.092] ;	RX=2.7*RSTJ2*5.96
01750		FMPR	RX,STF+=8
01900	;	R6=RHORZ(R6)
02000	;	R9=RHORZ(R9)
02100	;	IF(J10.LT.10)GO TO 91
02200	C NEXT FOR INNER, PARTIAL BEAMS
02300	;	R8=RHORZ(R8)
02400	;	R10=AMOD(R10,10.)
02500	;	GO TO(2,3,4),J10/10
02600	2;	R8=R9+RX
02700	;	GO TO 4
02800	3;	R8=R9-RX
02900	C 10=SHORT PARTIAL LFT→RT., 20=RT.←LFT, 30=TO POS IN P8
03000	4;	RH=R8
03100	C  LEFT INNER POS.
03200	;	GO TO 1
03300	C******************************
03400	91;	IF(J8.GE.0)GO TO 1
03500	92;	R9=R3+RX
03600	;	IF(J8.LE.-20)R9=R6-RX
03700	192;	J8=-J8
03800	;	IF(J10.EQ.0)J10=MOD(J8,10)
03900	;	J8=J8-J10
04000	;	IF(J10.EQ.0)J10=1
04100	;	R10=J10
04200	C IF P8 NEG, P9 IS AUTOMATIC, ALSO P10 IF NEEDED.
04300	1;	IF(IABS(J4).LT.100)GO TO 97
04400	;	RMINI=.6*RSTJ2
04500	;	R5=AMOD(R5,100.0)
04600	C   SPACE BETWEEN BEAMS
04700	97;	RJ=RMINI*11.
04800	;	RW=RMINI*RHGT
04900	C  DIST. UP OR DOWN FROM NOTE HEAD.
05000	;	RJA=R10*RJ
05100	C  DISPLACEMENT
05300	;	RD=R9
05400	C  POSITION 3
05500	;	RJX=CENTR-RW+RJA
05600	C  FINAL HEIGHT
05800	;	IF(J7)J7=-J7
05900	C  NEG R7=TREMOLO
06000	;	RX=MOD(J7,10)
06100	;	JJ2=J7-20
06200	;	RA=R6
06300	C  HORIZANTAL DIST.
06400	;	RJY=R5*RST7+POS-RST18-RW+RJA
06500	C************************
06600	;	RW=R14*RMINI
06700	;	RY=1.
06800	;	IF(J7.GE.20)GO TO 930
06900	C JUMP IF STEMS ARE DOWN
07000	;	RY=-RY
07100	C  FOR  THICKENING INCR.
07200	;	JJ2=J7-10
07300	;	RJ=-RJ
07800	;	RJA=RMINI*R2HGT-2.*RJA
07900	;	RJX=RJX+RJA
08000	;	RJY=RJY+RJA
08100	;	R3Q=R3Q+RW
08200	C  POSITION 1
08300	;	RA=RA+RW
08400	C  POSITION 2
08500	;	RD=RD+RW
08600	C******************************
08700	;	RH=RH+RW
08800	930;	IF(R7.GE.0)GO TO 98
08900	;	R3Q=R3Q-13.*RSTJ2
09000	C  SHIFTS HEAD OF TREM. TO LEFT.
09100	;	RA=R3Q+27.*RSTJ2
09200	98;	RSTJ2=RSTJ2*RBM
09300	C  RBM BRINGS LINES OF BEAMS CLOSER TOGETHER. (=.83)
09400	93;	IF(JJ2.GT.RX)GO TO 94
09500	;	IF(J10.GE.10)GO TO 7
09600	C**********************
09700	;	IF(J8.EQ.0)GO TO 94
09800	;	R3=RW
09900	C******************************
10100	;	IF(J9.EQ.0)GO TO 292
10200	 ;	IF(J8.GE.20)GO TO 193
10300	C******************************
10500	293;	RX=R3Q-RD
10600	;	GO TO 194
10700	C******************************
10800	7;	RHX=RH-R3Q
11000	;	R3=RD-R3Q
11100	;	GO TO 292
11200	193;	RX=RD-RA
11300	194;	R3=ABS(RX)
11400	292;	DISX=ABS(R3Q-RA)
11500	;	HGT=RJX-RJY
11600	;	IF(J10.GE.10)HGT1=HGT*RHX/DISX
11700	C**********************
11800	;	R3=R3/DISX
11900	195;	HGT=HGT*R3
12000	196;	L=J8/10
12100	;	J8=0
12200	;	IF(J10.GE.10)GO TO 8
12300	C***************
12400	;	IF(L.EQ.1)GO TO 95
12500	C   BEAM LFT=1,  RT=2   (PARAM 8=10 OR 20)
12600	;	R3Q=RD
12700	;	RJX=RJY+HGT
12800	;	GO TO 94
12900	C**************
13000	8;	R3Q=RH
13100	;	RA=RD
13200	;	RJY=RJX-HGT
13300	;	RJX=RJX-HGT1
13400	;	GO TO 94
13500	95;	RA=RD
13600	;	RJY=RJX-HGT
13700	94;	RC=0
13800	CXX;	L=8
14000	CXX;	IF(RMINI.LT.1.)L=7.*RMINI
14100	;	L=8.*RMINI
14200	C  MINI LINES HAVE .2 SMALLER BEAMS.  MAYBE CHANGE THIS??
14300	;	CALL LINES(R3Q,RJX,3)
14400	;	DO 941 K=1,L
14500	;	CALL BMS
14600	;	IF(PLT.GE.0)GO TO 940
14800	;	RC=RC+RY
14900	C FOR THICKENING.
15000	;	CALL BMS
15100	;	CALL EXCH(RA,R3Q)
15200	941;	CALL EXCH(RJY,RJX)
15300	;	CALL BMS
15400	C  DRAWS 5 LINES FOR BEAMS.
15500	940;	JJ2=JJ2-1
15600	;	IF(JJ2.LE.0)RETURN
15700	C  IF P7=10 OR 20 ONE BEAM WILL APPEAR.
15800	;	RJY=RJY+RJ
15900	;	RJX=RJX+RJ
16000	;	GO TO 93